home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 037a / mouslib5.zip / MOUSELIB.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-12  |  33KB  |  898 lines
  1. (******************************************************************************
  2. *                                  MouseLib                                   *
  3. *                second release, written by Loewy Ron, AUG 90                           *
  4. *           Third  release, TP6.0 asm support, LR Jan 91.                     *
  5. *           4TH release, added functions, LR FEB. 91.                         *
  6. *           5th release, added intercept & release functions                  *
  7. ******************************************************************************)
  8. unit MouseLib;
  9.  
  10. interface
  11.  
  12. uses 
  13.     dos
  14.     ;
  15.  
  16. const
  17.     MOUSEINT = $33; {mouse driver interrupt}
  18.     LEFTBUTTON = 1; {bit 0}
  19.     RIGHTBUTTON = 2; {bit 1}
  20.     MIDDLEBUTTON = 4; {bit 2}
  21.  
  22.     CURSOR_LOCATION_CHANGED = 1; {event mask bits}
  23.     LEFT_BUTTON_PRESSED = 2;
  24.     LEFT_BUTTON_RELEASED = 4;
  25.     RIGHT_BUTTON_PRESSED = 8;
  26.     RIGHT_BUTTON_RELEASED = 16;
  27.     MIDDLE_BUTTON_PRESSED = 32;
  28.     MIDDLE_BUTTON_RELEASED = 64;
  29.  
  30. type
  31.     mouseType = (twoButton,threeButton,another);
  32.     buttonState = (buttonDown,buttonUp);
  33.     direction = (moveRight,moveLeft,moveUp,moveDown,noMove);
  34.     grCursorType = record
  35.         xH,yH : byte; {x,y Hot Point}
  36.         data  : pointer;  {cursor look pointer}
  37.     end;
  38. var
  39.     mouse_present : boolean;
  40.     mouse_buttons : mouseType;
  41.     eventX,eventY,eventButtons : word; {any event handler should update}
  42.     eventhappened : Boolean;       {these vars to use getLastEvent }
  43.     XMotions,YMotions : word;       {per 8 pixels}
  44.     mouseCursorLevel : integer;
  45.  
  46.     {if > 0 mouse cursor is visiable, otherwise not, containes the level
  47.      of showMouseCursor/hideMouseCursor}
  48.  
  49. const    LastMask : word = 0;
  50.     lastHandler : pointer = Nil;
  51.  
  52.     {when changing the interrupt handler temporarily, save BEFORE the
  53.         change these to variables, and restore them when neccessary}
  54.  
  55.     lastCursor : grCursorType = (
  56.         xH : 0;
  57.         yH : 0;
  58.         data : nil );
  59.  
  60.     {when changing graphic cursor temporarily, save these values BEFORE
  61.         the change, and restore when neccessary}
  62.  
  63. const
  64.     click_repeat  = 10; { Recommended value for waitForRelease timeOut }
  65.  
  66. procedure initMouse; {when replacing mouse mode do that..!}
  67. procedure showMouseCursor;
  68. procedure hideMouseCursor;
  69. function getMouseX : word;
  70. function getMouseY : word;
  71. function getButton(Button : Byte) : buttonState;
  72. function buttonPressed : boolean;
  73. procedure setMouseCursor(x,y : word);
  74. function LastXPress(Button : Byte) : word;
  75. function LastYPress(Button : Byte) : word;
  76. function ButtonPresses(Button : Byte) : word; {from last last check}
  77. function LastXRelease(Button : Byte) : word;
  78. function LastYRelease(Button : Byte) : word;
  79. function ButtonReleases(Button : Byte) : word; {from last last check}
  80. procedure mouseBox(left,top,right,bottom : word); {limit mouse rectangle}
  81. procedure graphicMouseCursor(xHotPoint,yHotPoint : byte; dataOfs : pointer);
  82. procedure HardwareTextCursor(fromLine,toLine : byte);
  83. procedure softwareTextCursor(screenMask,cursorMask : word);
  84. function recentXmovement : direction;
  85. function recentYmovement : direction;
  86. procedure setArrowCursor;
  87. procedure setWatchCursor;
  88. procedure setUpArrowCursor;
  89. procedure setLeftArrowCursor;
  90. procedure setCheckMarkCursor;
  91. procedure setPointingHandCursor;
  92. procedure setDiagonalCrossCursor;
  93. procedure setRectangularCrossCursor;
  94. procedure setHourGlassCursor;
  95. procedure setNewWatchCursor;
  96. procedure setEventHandler(mask : word; handler    : pointer);
  97. procedure setDefaultHandler(mask : word);
  98. procedure enableLightPenEmulation;
  99. procedure disableLightPenEmulation;
  100. procedure defineSensetivity(x,y : word);
  101. procedure setHideCursorBox(left,top,right,bottom : word);
  102. procedure defineDoubleSpeedTreshHold(treshHold : word);
  103. procedure disableTreshHold;
  104. procedure defaultTreshHold;
  105. procedure setMouseGraph;
  106. procedure resetMouseGraph;
  107. procedure waitForRelease(timeOut : word);
  108. procedure swapEventHandler(mask : word; handler : pointer); 
  109. { return old in lastMask and lastHandler }
  110. function getMouseSaveStateSize : word;
  111. procedure interceptMouse; { get mouse from interrupted program, and stop it .. }
  112. procedure restoreMouse;
  113.  
  114. (*                mouseLib     -      Release 2                                        *)
  115. (*                                                                                          *)
  116. (* because of quirks in hercules graphic mode that is not detectable       *)
  117. (*  by the mouse driver we have to know when we initMouse if we want       *)
  118. (*  to check for graphic mode or not, if we do we must perform a           *)
  119. (*  setMouseGraph before initGraph, to initGraph in text mode we must    *)
  120. (*  resetMouseGraph before.. , if these calling conventions are not        *)
  121. (*  taken we might have problems in hercules cards!                           *)
  122. (*                                                                                          *)
  123. (* each call to hideMouseCursor must be balanced by a matching call        *)
  124. (*  to showMouseCursor, 2 calls to hideMou.. and only 1 to showM..        *)
  125. (*  will not show the mouse cursor on the screen!                              *)
  126.  
  127.  
  128. implementation
  129.  
  130. const watchData : array [0..31] of word =
  131.     ($E007,$C003,$8001,$0,$0,$0,$0,$0,$0,$0,$0,$0,$0,$8001,$C003,$E007,
  132.      $0,$1FF8,$318C,$6186,$4012,$4022,$4042,$718C,$718C,$4062,$4032,
  133.      $4002,$6186,$318C,$1FF8,$0);
  134.  
  135. const arrowData : array [0..31] of word =
  136.     ($FFFF,$8FFF,$8FFF,$87FF,$83FF,$81FF,$80FF,$807F,$803F,$801F,$800F,
  137.      $801F,$807F,$887F,$DC3F,$FC3F,
  138.      $0,$0,$2000,$3000,$3800,$3C00,$3E00,$3F00,$3F80,$3FC0,
  139.      $3FE0,$3E00,$3300,$2300,$0180,$0180);
  140.  
  141. const UpArrowCursor : array [0..31] of word =
  142.          ($f9ff,$f0ff,$e07f,$e07f,$c03f,$c03f,$801f,$801f,
  143.           $f,$f,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,$f0ff,
  144.           $0,$600,$f00,$f00,$1f80,$1f80,$3fc0,$3fc0,
  145.           $7fe0,$600, $600, $600, $600, $600, $600, $600);
  146.  
  147. const  LeftArrowCursor : array [0..31] of word
  148.        = ($fe1f,$f01f,$0,   $0,   $0,   $f01f,$fe1f,$ffff,
  149.           $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  150.           $0,   $c0,  $7c0, $7ffe,$7c0, $c0,  $0,   $0,
  151.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0);
  152.  
  153. const  CheckMarkCursor : array [0..31] of word
  154.        = ($fff0,$ffe0,$ffc0,$ff81,$ff03,$607, $f,   $1f,
  155.           $c03f,$f07f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  156.           $0,   $6,   $c,   $18,  $30,  $60,  $70c0,$1d80,
  157.           $700, $0,   $0,   $0,   $0,   $0,   $0,   $0);
  158.  
  159. const  PointingHandCursor : array [0..31] of word
  160.        = ($e1ff,$e1ff,$e1ff,$e1ff,$e1ff,$e000,$e000,$e000,
  161.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0,
  162.           $1e00,$1200,$1200,$1200,$1200,$13ff,$1249,$1249,
  163.           $f249,$9001,$9001,$9001,$8001,$8001,$8001,$ffff);
  164.  
  165. const  DiagonalcrossCursor : array [0..31] of word
  166.        = ($7e0, $180, $0,   $c003,$f00f,$c003,$0,   $180,
  167.           $7e0, $ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  168.           $0,   $700e,$1c38,$660, $3c0, $660, $1c38,$700e,
  169.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0);
  170.  
  171. const  RectangularCrossCursor : array [0..31] of word
  172.        = ($fc3f,$fc3f,$fc3f,$0,$0,   $0,   $fc3f,$fc3f,
  173.           $fc3f,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
  174.           $0,   $180, $180, $180, $7ffe,$180, $180, $180,
  175.           $0,   $0,   $0,   $0,   $0,   $0,   $0,   $0);
  176.  
  177. const  HourglassCursor : array [0..31] of word
  178.        = ($0,   $0,   $0,   $0,   $8001,$c003,$e007,$f00f,
  179.           $e007,$c003,$8001,$0,   $0,   $0,   $0,   $ffff,
  180.           $0,   $7ffe,$6006,$300c,$1818,$c30, $660, $3c0,
  181.           $660, $c30, $1998,$33cc,$67e6,$7ffe,$0,   $0);
  182.  
  183. const newWatchCursor : array [0..31] of word
  184.        = ( $ffff, $c003, $8001, $0, $0, $0, $0, $0, $0, 
  185.            $0, $0, $0, $0, $8001, $c003, $ffff, $0, $0, 
  186.            $1ff8, $2004, $4992, $4022, $4042, $518a, $4782, 
  187.            $4002, $4992, $4002, $2004, $1ff8, $0, $0 );
  188.        
  189.  
  190. const mouseGraph : boolean = False; {assume text mode upon entry}
  191.  
  192. type box = record
  193.         left,top,right,bottom : word;
  194.     end; {Do not change field order !!!}
  195.  
  196. var hideBox : box;
  197. var reg : registers;  {general registers used}
  198. var grMode,grDrv : integer; {detect graphic mode if any}
  199. grCode : integer;     {return initgraph code in here}
  200.  
  201. var
  202.    interceptX, interceptY : word;
  203.  
  204. (******************************************************************************
  205. *                                  callMouse                                  *
  206. *                                                                             *
  207. * used to call mouse interrupt with global data reg - used as parameters      *
  208. ******************************************************************************)
  209. procedure callMouse;
  210. begin
  211.         intr(MOUSEINT,REG);
  212. end; {callMouse}
  213.  
  214. (******************************************************************************
  215. *                                  initMouse                                  *
  216. * For some reason grCode is assigned a value of -11,($FFF5) in the second time*
  217. *  we call initmouse after we allready are in graphics mode, override.. was   *
  218. *  born because of that situation.                                            *
  219. ******************************************************************************)
  220. procedure initMouse;
  221. var
  222.     overRideDriver : boolean; { true if we over-ridden stupid driver hercules bug }
  223. begin
  224.     overRideDriver := false;
  225.     if (mouseGraph and (mem[0:$449] = 7)) then begin { assume no mda - hercules }
  226.       mem[0:$449] := 6;
  227.       overRideDriver := true;
  228.     end;
  229.       {trick stupid mouse driver to know we are in graphic mode}
  230.     with reg do begin
  231.         ax:=0; {detect genius mouse}
  232.         bx:=0; {be sure what mode we get}
  233.         callMouse;
  234.         mouse_present := (ax <> 0); {not an iret..}
  235.         if ((bx and 2) <> 0)
  236.             then mouse_buttons := twoButton
  237.         else if ((bx and 3) <> 0)
  238.             then mouse_buttons := threeButton
  239.         else mouse_buttons := another; {unknown to us}
  240.     end; {with}
  241.     if (overRideDriver) then
  242.       mem[0:$449] := 7;
  243.       {restore the stupid situation}
  244.        eventX := 0;
  245.        eventButtons := 0;
  246.        eventY := 0;
  247.        eventhappened := False;
  248.        XMotions := 8;
  249.        YMotions := 16;
  250.        mouseCursorLevel := 0; { not visiable, one show to appear }
  251. end; {initMouse}
  252.  
  253. (******************************************************************************
  254. *                               showMouseCursor                               *
  255. ******************************************************************************)
  256. procedure showMouseCursor;
  257.  
  258. begin
  259.     reg.ax:=1; {enable cursor display}
  260.     callMouse;
  261.     inc(mouseCursorLevel);
  262. end; {showMouseCursor}
  263.  
  264. (******************************************************************************
  265. *                               hideMouseCursor                               *
  266. ******************************************************************************)
  267. procedure hideMouseCursor;
  268.  
  269. begin
  270.     reg.ax:=2; {disable cursor display}
  271.     callMouse;
  272.     dec(mouseCursorLevel);
  273. end; {hideMouseCursor}
  274.  
  275. (******************************************************************************
  276. *                                  getMouseX                                  *
  277. ******************************************************************************)
  278. function getMouseX : word;
  279.  
  280. begin
  281.     reg.ax := 3;
  282.     callMouse;
  283.     getMouseX := reg.cx;
  284. end; {getMouseX}
  285.  
  286. (******************************************************************************
  287. *                                  getMouseY                                  *
  288. ******************************************************************************)
  289. function getMouseY : word;
  290.  
  291. begin
  292.     reg.ax := 3;
  293.     callMouse;
  294.     getMouseY := reg.dx;
  295. end; {getMouseX}
  296.  
  297. (******************************************************************************
  298. *                                  getButton                                  *
  299. ******************************************************************************)
  300. function getButton(Button : Byte) : buttonState;
  301.  
  302. begin
  303.     reg.ax := 3;
  304.     callMouse;
  305.     if ((reg.bx and Button) <> 0) then
  306.         getButton := buttonDown
  307.         {bit 0 = left, 1 = right, 2 = middle}
  308.     else getButton := buttonUp;
  309. end; {getButton}
  310.  
  311. (******************************************************************************
  312. *                                buttonPressed                                *
  313. ******************************************************************************)
  314. function buttonPressed : boolean;
  315.  
  316. begin
  317.     reg.ax := 3;
  318.     callMouse;
  319.     if ((reg.bx and 7) <> 0) then
  320.         buttonPressed := True
  321.     else buttonPressed := False;
  322. end; {buttonPressed}
  323.  
  324. (******************************************************************************
  325. *                               setMouseCursor                               *
  326. ******************************************************************************)
  327. procedure setMouseCursor(x,y : word);
  328.  
  329. begin
  330.     with reg do begin
  331.         ax := 4;
  332.         cx := x;
  333.         dx := y; {prepare parameters}
  334.         callMouse;
  335.     end; {with}
  336. end; {setMouseCursor}
  337.  
  338. (******************************************************************************
  339. *                                 lastXPress                                 *
  340. ******************************************************************************)
  341. function lastXPress(Button : Byte) : word;
  342.  
  343. begin
  344.     reg.ax := 5;
  345.     reg.bx := Button;
  346.     callMouse;
  347.     lastXPress := reg.cx;
  348. end; {lastXpress}
  349.  
  350. (******************************************************************************
  351. *                                 lastYPress                                 *
  352. ******************************************************************************)
  353. function lastYPress(Button : Byte) : word;
  354.  
  355. begin
  356.     reg.ax := 5;
  357.     reg.bx := Button;
  358.     callMouse;
  359.     lastYPress := reg.dx;
  360. end; {lastYpress}
  361.  
  362. (******************************************************************************
  363. *                                buttonPresses                                *
  364. ******************************************************************************)
  365. function buttonPresses(Button : Byte) : word; {from last check}
  366.  
  367. begin
  368.     reg.ax := 5;
  369.     reg.bx := Button;
  370.     callMouse;
  371.     buttonPresses := reg.bx;
  372. end; {buttonPresses}
  373.  
  374. (******************************************************************************
  375. *                                lastXRelease                                *
  376. ******************************************************************************)
  377. function lastXRelease(Button : Byte) : word;
  378.  
  379. begin
  380.     reg.ax := 6;
  381.     reg.bx := Button;
  382.     callMouse;
  383.     lastXRelease := reg.cx;
  384. end; {lastXRelease}
  385.  
  386. (******************************************************************************
  387. *                                lastYRelease                                *
  388. ******************************************************************************)
  389. function lastYRelease(Button : Byte) : word;
  390.  
  391. begin
  392.     reg.ax := 6;
  393.     reg.bx := Button;
  394.     callMouse;
  395.     lastYRelease := reg.dx;
  396. end; {lastYRelease}
  397.  
  398. (******************************************************************************
  399. *                               buttonReleases                               *
  400. ******************************************************************************)
  401. function buttonReleases(Button : Byte) : word; {from last check}
  402.  
  403. begin
  404.     reg.ax := 6;
  405.     reg.bx := Button;
  406.     callMouse;
  407.     buttonReleases := reg.bx;
  408. end; {buttonReleases}
  409.  
  410. (******************************************************************************
  411. *                                    swap                                    *
  412. ******************************************************************************)
  413. procedure swap(var a,b : word);
  414.  
  415. var c : word;
  416.  
  417. begin
  418.     c := a;
  419.     a := b;
  420.     b := c; {swap a and b}
  421. end; {swap}
  422.  
  423. (******************************************************************************
  424. *                                  mouseBox                                  *
  425. ******************************************************************************)
  426. procedure mouseBox(left,top,right,bottom : word);
  427.  
  428. begin
  429.     if (left > right) then swap(left,right);
  430.     if (top > bottom) then swap(top,bottom); {make sure they are ordered}
  431.     reg.ax := 7;
  432.     reg.cx := left;
  433.     reg.dx := right;
  434.     callMouse; {set x range}
  435.     reg.ax := 8;
  436.     reg.cx := top;
  437.     reg.dx := bottom;
  438.     callMouse; {set y range}
  439. end; {mouseBox}
  440.  
  441. (******************************************************************************
  442. *                             graphicMouseCursor                              *
  443. ******************************************************************************)
  444. procedure graphicMouseCursor(xHotPoint,yHotPoint : byte; dataOfs : pointer);
  445.  
  446. {define 16*16 cursor mask and screen mask, pointed by data,
  447.     dataOfs is pointer to data of the masks.}
  448.  
  449. begin
  450.     reg.ax := 9;
  451.     reg.bx := xHotPoint;
  452.     reg.cx := yHotPoint;
  453.     reg.dx := ofs(dataOfs^);    {DS:DX point to masks}
  454.     reg.es := seg(dataOfs^);
  455.     callMouse;
  456.     lastCursor.xH := xHotPoint;
  457.     lastCursor.yH := yHotPoint;
  458.     lastCursor.data := dataOfs;
  459.     {save it in lastCursor, if someone needs to change cursor temporary}
  460. end; {graphicMouseCursor}
  461.  
  462. (******************************************************************************
  463. *                             HardwareTextCursor                             *
  464. ******************************************************************************)
  465. procedure HardwareTextCursor(fromLine,toLine : byte);
  466.  
  467. {set text cursor to text, using the scan lines from..to,
  468.     same as intr 10 cursor set in bios :
  469.     color scan lines 0..7, monochrome 0..13 }
  470.  
  471. begin
  472.     reg.ax := 10;
  473.     reg.bx := 1; {hardware text}
  474.     reg.cx := fromLine;
  475.     reg.dx := toLine;
  476.     callMouse;
  477. end; {hardwareTextCursor}
  478.  
  479. (******************************************************************************
  480. *                             softwareTextCursor                             *
  481. ******************************************************************************)
  482. procedure softwareTextCursor(screenMask,cursorMask : word);
  483.  
  484. { when in this mode the cursor will be achived by ANDing the screen word
  485.     with the screen mask (Attr,Char in high,low order) and
  486.     XORing the cursor mask, ussually used by putting the screen attr
  487.     we want preserved in screen mask (and 0 into screen mask character
  488.     byte), and character + attributes we want to set into cursor mask}
  489.  
  490. begin
  491.     reg.ax := 10;
  492.     reg.bx := 0;    {software cursor}
  493.     reg.cx := screenMask;
  494.     reg.dx := cursorMask;
  495.     callMouse;
  496. end; {softwareMouseCursor}
  497.  
  498. (******************************************************************************
  499. *                               recentXmovement                               *
  500. ******************************************************************************)
  501. function recentXmovement : direction;
  502.  
  503. {from recent call to which direction did we move ?}
  504.  
  505. var d : integer;
  506.  
  507. begin
  508.     reg.ax := 11;
  509.     callMouse;
  510.     d := reg.cx;
  511.     if (d > 0)
  512.         then recentXmovement := moveRight
  513.     else if (d < 0)
  514.         then recentXmovement := moveLeft
  515.     else recentXmovement := noMove;
  516. end; {recentXmovement}
  517.  
  518. (******************************************************************************
  519. *                               recentYmovement                               *
  520. ******************************************************************************)
  521. function recentYmovement : direction;
  522.  
  523. {from recent call to which direction did we move ?}
  524.  
  525. var 
  526.    d : integer;
  527. begin
  528.     reg.ax := 11;
  529.     callMouse;
  530.     d := reg.dx;
  531.     if (d > 0)
  532.         then recentYmovement := moveDown
  533.     else if (d < 0)
  534.         then recentYmovement := moveUp
  535.     else recentYmovement := noMove;
  536. end; {recentYmovement}
  537.  
  538. (******************************************************************************
  539. *                               setWatchCursor                               *
  540. ******************************************************************************)
  541. procedure setWatchCursor;
  542. begin
  543.     graphicMouseCursor(0,0,@watchData);
  544. end; {setWatchCursor}
  545.  
  546. (******************************************************************************
  547. *                              setNewWatchCursor                              *
  548. ******************************************************************************)
  549. procedure setNewWatchCursor; 
  550. begin
  551.    graphicMouseCursor(0, 0, @newWatchCursor);
  552. end; {setNewWatchCursor}
  553.  
  554. (******************************************************************************
  555. *                              setUpArrowCursor                              *
  556. ******************************************************************************)
  557. procedure setUpArrowCursor;
  558. begin
  559.     graphicMouseCursor(5, 0, @upArrowCursor);
  560. end; {setUpArrowCursor}
  561.  
  562. (******************************************************************************
  563. *                             setLeftArrowCursor                             *
  564. ******************************************************************************)
  565. procedure setLeftArrowCursor;
  566. begin
  567.     graphicMouseCursor(0, 3, @leftArrowCursor);
  568. end; {setLeftArrowCursor}
  569.  
  570. (******************************************************************************
  571. *                             setCheckMarkCursor                             *
  572. ******************************************************************************)
  573. procedure setCheckMarkCursor;
  574. begin
  575.     graphicMouseCursor(6, 7, @checkMarkCursor);
  576. end; {setCheckMarkCursor}
  577.  
  578. (******************************************************************************
  579. *                            setPointingHandCursor                            *
  580. ******************************************************************************)
  581. procedure setPointingHandCursor;
  582. begin
  583.     graphicMouseCursor(5, 0, @pointingHandCursor);
  584. end; {setPointingHandCursor}
  585.  
  586. (******************************************************************************
  587. *                           setDiagonalCrossCursor                           *
  588. ******************************************************************************)
  589. procedure setDiagonalCrossCursor;
  590. begin
  591.     graphicMouseCursor(7, 4, @diagonalCrossCursor);
  592. end; {setDiagonalCrossCursor}
  593.  
  594. (******************************************************************************
  595. *                          setRectangularCrossCursor                          *
  596. ******************************************************************************)
  597. procedure setRectangularCrossCursor;
  598. begin
  599.     graphicMouseCursor(7, 4, @rectangularCrossCursor);
  600. end; {setRectangularCrossCursor}
  601.  
  602. (******************************************************************************
  603. *                             setHourGlassCursor                             *
  604. ******************************************************************************)
  605. procedure setHourGlassCursor;
  606. begin
  607.     graphicMouseCursor(7, 7, @hourGlassCursor);
  608. end; {setHourGlassCursor}
  609.  
  610. (******************************************************************************
  611. *                               setArrowCursor                               *
  612. ******************************************************************************)
  613. procedure setArrowCursor;
  614. begin
  615.     graphicMouseCursor(1,1,@arrowData);
  616. end; {setArrowCursor}
  617.  
  618. (******************************************************************************
  619. *                               setEventHandler                               *
  620. ******************************************************************************)
  621. procedure setEventHandler(mask : word; handler    : pointer);
  622.  
  623. {handler must be a far interrupt routine }
  624.  
  625. begin
  626.     reg.ax := 12; {set event handler function in mouse driver}
  627.     reg.cx := mask;
  628.     reg.es := seg(handler^);
  629.     reg.dx := ofs(handler^);
  630.     callMouse;
  631.     lastMask := mask;
  632.     lastHandler := handler;
  633. end; {set event Handler}
  634.  
  635. (******************************************************************************
  636. *                               defaultHandler                               *
  637. ******************************************************************************)
  638. {$F+} procedure defaultHandler; assembler; {$F-}
  639. asm
  640.    push ds; { save TP mouse driver }
  641.    mov ax, SEG @data;
  642.    mov ds, ax; { ds = TP:ds, not the driver's ds }
  643.    mov eventX, cx; { where in the x region did it occur }
  644.    mov eventY, dx;
  645.    mov eventButtons, bx;
  646.    mov eventHappened, 1; { eventHapppened := true }
  647.    pop ds; { restore driver's ds }
  648.    ret;
  649. end;
  650.  
  651. {   this is the default event handler , it simulates :
  652.  
  653.       begin
  654.            eventX := cx;
  655.            eventY := dx;
  656.            eventButtons := bx;
  657.            eventhappened := True;
  658.       end;
  659.  
  660. }
  661.  
  662. (******************************************************************************
  663. *                                GetLastEvent                                *
  664. ******************************************************************************)
  665. function GetLastEvent(var x,y : word;
  666.     var left_button,right_button,middle_button : buttonState) : boolean;
  667.  
  668. begin
  669.     getLastEvent := eventhappened; {indicate if any event happened}
  670.     eventhappened := False; {clear to next read/event}
  671.     x := eventX;
  672.     y := eventY;
  673.     if ((eventButtons and LEFTBUTTON) <> 0) then
  674.         left_button := buttonDown
  675.     else left_button := buttonUp;
  676.     if ((eventButtons and RIGHTBUTTON) <> 0) then
  677.         right_button := buttonDown
  678.     else right_button := buttonUp;
  679.     if ((eventButtons and MIDDLEBUTTON) <> 0) then
  680.         middle_button := buttonDown
  681.     else middle_button := buttonUp;
  682. end; {getLastEvent}
  683.  
  684. (******************************************************************************
  685. *                              setDefaultHandler                              *
  686. ******************************************************************************)
  687. procedure setDefaultHandler;
  688.  
  689. {get only event mask, and set event handler to defaultHandler}
  690.  
  691. begin
  692.     setEventHandler(mask,@defaultHandler);
  693. end; {setDefaultHandler}
  694.  
  695. (******************************************************************************
  696. *                           enableLightPenEmulation                           *
  697. ******************************************************************************)
  698. procedure enableLightPenEmulation;
  699.  
  700. begin
  701.     reg.ax := 13;
  702.     callMouse;
  703. end; {enableLightPenEmulation}
  704.  
  705. (******************************************************************************
  706. *                          disableLightPenEmulation                          *
  707. ******************************************************************************)
  708. procedure disableLightPenEmulation;
  709.  
  710. begin
  711.     reg.ax := 14;
  712.     callMouse;
  713. end;  {disableLightPenEmulation}
  714.  
  715. (******************************************************************************
  716. *                              defineSensetivity                              *
  717. ******************************************************************************)
  718. procedure defineSensetivity(x,y : word);
  719.  
  720. begin
  721.     reg.ax := 15;
  722.     reg.cx := x; {# of mouse motions to horizontal 8 pixels}
  723.     reg.dx := y; {# of mouse motions to vertical 8 pixels}
  724.     callMouse;
  725.     XMotions := x;
  726.     YMotions := y; {update global unit variables}
  727. end; {defineSensetivity}
  728.  
  729. (******************************************************************************
  730. *                              setHideCursorBox                              *
  731. ******************************************************************************)
  732. procedure setHideCursorBox(left,top,right,bottom : word);
  733.  
  734. begin
  735.     reg.ax := 16;
  736.     reg.es := seg(HideBox);
  737.     reg.dx := ofs(HideBox);
  738.     HideBox.left := left;
  739.     HideBox.right := right;
  740.     HideBox.top := top;
  741.     HideBox.bottom := bottom;
  742.     callMouse;
  743. end; {setHideCursorBox}
  744.  
  745. (******************************************************************************
  746. *                         defineDoubleSpeedTreshHold                         *
  747. ******************************************************************************)
  748. procedure defineDoubleSpeedTreshHold(treshHold : word);
  749.  
  750. begin
  751.     reg.ax := 17;
  752.     reg.dx := treshHold;
  753.     callMouse;
  754. end; {defineDoubleSpeedTreshHold - from what speed to double mouse movement}
  755.  
  756. (******************************************************************************
  757. *                              disableTreshHold                              *
  758. ******************************************************************************)
  759. procedure disableTreshHold;
  760.  
  761. begin
  762.     defineDoubleSpeedTreshHold($7FFF);
  763. end; {disableTreshHold}
  764.  
  765. (******************************************************************************
  766. *                              defaultTreshHold                              *
  767. ******************************************************************************)
  768. procedure defaultTreshHold;
  769.  
  770. begin
  771.     defineDoubleSpeedTreshHold(64);
  772. end; {defaultTreshHold}
  773.  
  774. (******************************************************************************
  775. *                                setMouseGraph                                *
  776. ******************************************************************************)
  777. procedure setMouseGraph;
  778.  
  779. begin
  780.     mouseGraph := True;
  781. end; {setMouseGraph}
  782.  
  783. (******************************************************************************
  784. *                               resetMouseGraph                               *
  785. ******************************************************************************)
  786. procedure resetMouseGraph;
  787.  
  788. begin
  789.     mouseGraph := False;
  790. end; {resetMouseGraph}
  791.  
  792.  
  793. (********************************************************************************
  794. *                                 waitForRelease                                    *
  795. * Wait until button is release, or timeOut 1/100 seconds pass. (might miss a       *
  796. * tenth (1/10) of a second.                                                           *
  797. ********************************************************************************)
  798. procedure waitForRelease;
  799. var
  800.     sHour, sMinute, sSecond, sSec100 : word;    { Time at start }
  801.     cHour, cMinute, cSecond, cSec100 : word;    { Current time    }
  802.     stopSec                 : longInt;
  803.     currentSec                 : longInt;
  804.     Delta                 : longInt;
  805. begin
  806.     getTime(sHour, sMinute, sSecond, sSec100);
  807.     stopSec := (sHour*36000 + sMinute*600 + sSecond*10 + sSec100 + timeOut) mod
  808.           (24*360000);
  809.     repeat
  810.     getTime(cHour, cMinute, cSecond, cSec100);
  811.     currentSec := (cHour*36000 + cMinute*600 + cSecond*10 + cSec100);
  812.     Delta := currentSec - stopSec;
  813.     until (not ButtonPressed) or (Delta >=0) and (Delta < 36000);
  814. end; {waitForRelease}
  815.  
  816. (******************************************************************************
  817. *                              swapEventHandler                               *
  818. * handler is a far routine.                                                   *
  819. ******************************************************************************)
  820. procedure swapEventHandler;
  821. begin
  822.    reg.ax := $14;
  823.    reg.cx := mask;
  824.     reg.es := seg(handler^);
  825.     reg.dx := ofs(handler^);
  826.     callMouse;
  827.    lastMask := reg.cx;
  828.    lastHandler := ptr(reg.es,reg.dx);
  829. end; {swapEventHandler}
  830.  
  831. (******************************************************************************
  832. *                            getMouseSaveStateSize                            *
  833. ******************************************************************************)
  834. function getMouseSaveStateSize;
  835. begin
  836.    reg.ax := $15;
  837.    callMouse;
  838.    getMouseSaveStateSize := reg.bx;
  839. end; {getMouseSaveStateSize}
  840.  
  841. (******************************************************************************
  842. *                               interceptMouse                                *
  843. ******************************************************************************)
  844. procedure interceptMouse;
  845. begin
  846.    with reg do begin
  847.       ax := 3;
  848.       callMouse; { get place .. }
  849.       interceptX := cx;
  850.       interceptY := dx;
  851.       ax := 31;
  852.       callMouse;
  853.    end; { disable mouse driver .. }
  854. end; {interceptMouse}
  855.  
  856. (******************************************************************************
  857. *                                restoreMouse                                 *
  858. ******************************************************************************)
  859. procedure restoreMouse;
  860. begin
  861.    with reg do begin
  862.       ax := 32; { restore mouse driver .. }
  863.       callMouse;
  864.       ax := 4;
  865.       cx := interceptX;
  866.       dx := interceptY;
  867.       callMouse;
  868.    end; { with .. }
  869. end; {restoreMouse}
  870.  
  871. var
  872.     OldExitProc : pointer;
  873.  
  874. (******************************************************************************
  875. *                                 MyExitProc                                 *
  876. ******************************************************************************)
  877. {$f+}procedure MyExitProc;
  878. begin
  879.     ExitProc := OldExitProc;
  880.     resetMouseGraph;
  881.     initMouse;
  882. end; { myExitProc }
  883.  
  884. { if this unit is used with a graphic unit that is loaded and executed after
  885.      this unit in the Uses clause, the mouse initialization will not be
  886.      correct, be sure to call initMouse in your program start to work
  887.      properly }
  888.  
  889. begin    {unit initialization}
  890.    eventX := 0;
  891.    eventY := 0;
  892.    eventHappened := false; { initialize ... }
  893.     initMouse; {detect in global variables}
  894.     setArrowCursor; {start like that in graphic mode}
  895.     OldExitProc := ExitProc;
  896.     ExitProc    := @MyExitProc;
  897. end. {mouseLib}
  898.